let verbose = false

open Ast

module ST = Map.Make(String)
let error= [| false |]


let operation_role (o : op) = match o with 
	  Add -> "add"
	| Equal -> "any"
	| Neq -> "any"
	| Less -> "basic"
	| Leq ->"basic"
	| Greater -> "basic"
	| Geq ->"basic"
	| And -> "int"
	| Or ->"int"
	| Mod ->"int"
	| Sub -> "num"
	| Mult ->"num"
	| Div ->"num"

let dir2str (d : dir) = match d with
	  In ->"in"
	| Out ->"out"
let type2str (t : typ) = match t with
	  Node -> "node"
	| Int -> "int"
	| Flt -> "flt"
	| Str -> "str"
	| Edg -> "edg"


let rec var2str (v : variable) = match v with
	  VarId s -> s
	| RecVar (v,s) -> var2str v
	| ArrayIndDyn (s,v) -> s
	| ArrayIndStat (s,i) -> s
	


let drop_arr s =
	let substr = String.sub s 0 3 in
	match substr with 
	 "nod" -> "node"
	| "edg" -> "edg"
	|_-> substr

let rec get_variable_type map (v : variable) = match v with
	  VarId(s) -> 
		
		if ST.mem s map then ST.find s map else "error"

	| RecVar(v,s1) -> 
		let vtyp = (get_variable_type map v) in
		if  vtyp = "node" || vtyp ="edg"
		then "int"
		else "error"
	| ArrayIndDyn (s,v) -> 
		if ST.mem s map && (get_variable_type map v ) = "int"  
		then drop_arr (ST.find s map)
		else "error"
	| ArrayIndStat (s,i) -> 
		if ST.mem  s map 
		then drop_arr (ST.find s map)
		else "error"

let check_node (v: variable) map = 
	if  (get_variable_type map v ) = "node"
	then true
	else (error.(0) <- true; print_endline ("Argument is not a node") ;false)

let check_edge (v: variable) map = 
	if ((get_variable_type map v) = "edg") 
	then true
	else (error.(0) <- true; print_endline ("Argument is not a edge") ;false)

let check_index v map =
	(get_variable_type map v) = "int" 

let addVar ( v: variable) (t: typ) map = match v with
	  VarId(s) -> (ST.add s (type2str t) map)		
	| ArrayIndStat (s,i) ->( ST.add s ((type2str t)^"arr") map) 		
	| ArrayIndDyn (s,v) -> 	if check_index v map 
				then (ST.add s ((type2str t)^"arr") map)
				else (print_endline ("Array size not int"); map) 		
	| _-> map



let check_con_var (v : variable) map=match v with

	  ArrayIndStat (s,i) -> 	
			if ( ST.mem s  map)
			then ( error.(0) <- true; print_endline (s ^ " already declared"); map)
			else (print_endline (s ^ " declared with connection context");
		     	 	ST.add s "nodearr" map )

			  		

	| ArrayIndDyn (s,v) -> 	
			if ( ST.mem s  map) || not (check_index v map)
			then ( error.(0) <- true;print_endline (s ^ " problem with connection context"); map)
			else (print_endline (s ^ " declared with connection context");
				ST.add s "nodearr" map)
	|_-> 	(error.(0) <- true;
			print_endline ((var2str v) ^ " not proper variable for connection context"); 
			map)




let op_check typ1 typ2 optyp  =
	match optyp with
	 "basic" -> typ1 = "str" || typ1 = "int" || typ1 = "flt"
	| "num" ->  typ1 = "flt"   || typ1 = "int"
	| "int" -> typ1 = "int" && typ2 = "int"
	| "add" -> typ1 = "str" || typ1 = "int" || typ1 = "flt"
	| "any" -> true
	| _ -> true
	


let rec get_expr_type map (e : expr) = match e with 
	  Lit_Flt f -> "flt"
	| Lit_Int i -> "int"
	| Lit_Str s -> "str"
	| Variable v -> (get_variable_type map v)
	| Binop (e1, op, e2) -> 
			let optyp = operation_role op in 
			let typ1 = get_expr_type map e1 in
			let typ2 = get_expr_type map e2 in
			if  	(op_check typ1 typ2 optyp)
				&& (typ1 = typ2  
				|| ( (typ1 = "int" || typ1 ="flt")
				 	&& (typ2 = "int" || typ2 = "flt")
					))
			then 	if optyp = "basic" || optyp = "any"
				then "int"
				else typ1

			else (	error.(0) <- true;
				 print_endline("cannot operate on " ^ typ1 ^ " and " ^ typ2 ^ " with " ^ optyp ^ " operation"); 				"error" ) 

			
		
	| Actuals(el) -> 
		 List.fold_left  (fun tp tc-> if (get_expr_type map tc) = tp 
					      then tp
					      else "error") 
				(get_expr_type map (List.hd el))
				el
	| NodeInEdge(v,e)->	
			if  (check_node v map) 
			then 	if (get_expr_type map e) = "int"
				then "edg"
				else (error.(0) <- true;print_endline("Inedge indexed with non int"); "error")
			else (error.(0) <- true;print_endline("Cannot call InEdge on variable");"error")
	| NodeOutEdge (v,e)-> 	
			if  (check_node v map) 
			then 	if (get_expr_type map e) = "int"
				then "edg"
				else (error.(0) <- true;print_endline("Outedge indexed with non int"); "error")
			else (error.(0) <- true;print_endline("Cannot call outedge on variable");"error")
	| NodeInEdges(v)-> 	
			if  (check_node v map) 
			then "int"
			else (error.(0) <- true;print_endline("Cannot call inedges on variable");"error")
	| NodeOutEdges (v)-> 	
			if(check_node v map) 
			then "int"
			else (error.(0) <- true;print_endline("Cannot call outedges on variable");"error")
	| EdgeInNode (v)-> 	
			if (check_edge v map) 
			then "node"
			else (error.(0) <- true;print_endline("Cannot call innode on variable");"error")
	|  EdgeOutNode(v)-> 	
			if(check_edge v map) 
			then "node"
			else (error.(0) <- true;print_endline("Cannot call outnode on variable");"error")
	| NodeChild(v,e) -> 
			if  (check_node v map) 
			then 	if (get_expr_type map e) = "int"
				then "node"
				else (	error.(0) <- true;
					print_endline("Nodechild indexed with non int"); 
					"error")
			else (error.(0) <- true;print_endline("Cannot call Nodechild on variable");"error")
	| NodeParent(v,e) -> 
			if  (check_node v map) 
			then 	if (get_expr_type map e) = "int"
				then "node"
				else (error.(0) <- true;
					print_endline("NodeParent indexed with non int"); 
					"error")
			else (error.(0) <- true;print_endline("Cannot call NodeParent on variable");"error")


(* keep track of the type as well as the variable name *)
let get_formals_from_fdecl formals = 
	let m (f : formal) = 
			match f with Validate(d, t, s) -> (s, (type2str t))
	in List.map m formals

let extract_type_from_formal (f : formal) = 
	match f with Validate(d, t, s) -> ((dir2str d) ,(type2str t))


let get_tuple_from_fdecl (f : func_decl) =	
	(f.fname, (List.fold_right (fun a b -> (extract_type_from_formal a)::b) f.formals []))


let assign_method (fdecl : func_decl) crawlh ruleh opth =
	match fdecl.func_type with 
	  "rule" -> 
		(fun a -> Hashtbl.add ruleh (fst a) (snd a) ) 
		(get_tuple_from_fdecl fdecl)
	| "opt" -> 
		(fun a -> Hashtbl.add opth (fst a) (snd a) ) 
		(get_tuple_from_fdecl fdecl)
	| "crawl" -> 
		(fun a -> Hashtbl.add crawlh (fst a) (snd a) ) 
		(get_tuple_from_fdecl fdecl)
        |      _ -> ( error.(0) <- true; print_endline "cannot identify method type") 
	 

let use_var name hash =
	if	ST.mem  name hash 
	then	true
	else	false

let check_assign  vtyp  (e : expr) map = 
	let exprtyp = (get_expr_type map e) in	
		 exprtyp = vtyp 
		|| (exprtyp = "int" &&  vtyp = "flt")
		|| (exprtyp = "flt" &&  vtyp = "int")
	
let add_special_var mtyp map =
	if mtyp = "rule" || mtyp = "crawl"
	then ST.add "current" "node" map
	else map



let check_argument map (e : expr) (dir, typ) =
	if dir = "out" 
	then match e with Variable(v) -> 
		if (get_variable_type map v ) = typ
		then true
		else false
	|	_-> false
	else
		if (get_expr_type map e) = typ
		then true
		else false
	

let rec check_args map explist arglist =
	if  (List.length explist = List.length arglist 
		&& ((List.length explist) =0 
			|| (check_argument map (List.hd explist)  (List.hd arglist))
		)) 
	then 
		if ((List.length explist) = 0)
		then	true
		else check_args map (List.tl explist) (List.tl arglist)
	else
		false


let make_table f g crawlh ruleh=

  	let formals_st = 
	      	let addtomap smap word =
		 	match word with 
			(s, t) ->
				if not (ST.mem s smap)
				then    (print_endline ("adding opt argument to symbol table: " ^ s); 
				    ST.add s t smap)
				else (error.(0) <- true;print_endline ("Argument name " ^ s ^ " used multiple times");
					smap)
	      	in
	      	List.fold_left addtomap (add_special_var f.func_type ST.empty) 
		(get_formals_from_fdecl f.formals)
   	in 
	let checkvar map (v : variable) = 
	       	if ST.mem (var2str v) map 
		then map
	       	else
			if Hashtbl.mem g (var2str v) 
			then map
			else 	(error.(0) <- true;
				print_endline ("ERROR: undeclared variable: " ^ (var2str v));
		       		map)
	in

let rec checkexp map (e : expr) =
	match e with
	  Lit_Flt f -> map
	| Lit_Str s -> map
	| Lit_Int i -> map
	| Actuals a -> List.fold_right (fun m n -> checkexp n m ) a map
	| Variable v -> checkvar map v
	| Binop (e1, o, e2) -> checkexp (checkexp map e1) e2
	| _ ->  (print_endline "unimplemented expression"; map)
in

let rec checkstmt map (s : stmt) = 
      match s with
      (* check declarations *)
          Declare_Only (t, v) -> 

		if ST.mem (var2str v) map 
		then
			(error.(0) <- true; print_endline ("ERROR: duplicate local declaration: " ^ (var2str v));
		      	map)
	  	else
			if Hashtbl.mem g (var2str v) 
			then (error.(0) <- true;
				print_endline ("ERROR: duplicate GLOBAL declaration: " ^ (var2str v));
				map)
			 else addVar v t map

	| Declare (t, v, e) -> 
		if ST.mem (var2str v) map 
		then
			(error.(0) <- true;
			print_endline ("ERROR: duplicate local declaration: " ^ (var2str v));
			map)
		else
		     if Hashtbl.mem g (var2str v) then
			 (error.(0) <- true;print_endline ("ERROR: duplicate GLOBAL declaration: " ^ (var2str v));
			  map)
		     else

		if check_assign  (type2str t) e map 
		then addVar v t map
		else 
			(error.(0) <- true;
			print_endline("Expression not of type "^(type2str t)^", variable not declared "  ); 
			map)
		
	| Assign (v, e) ->
		if ST.mem (var2str v) map 
		then
			if check_assign  (drop_arr (get_variable_type map v )) e map 
			then 	(print_endline((var2str v)^ " assigned value"); 
				map)
			else 	(error.(0) <- true;
				print_endline((var2str v)^"'s type did not match type"); 
				map)
		else
			(error.(0) <- true;
			(print_endline ((var2str v)^ " not defined.  Cannot assign value"));
			map)
      |CreateGraph (v,t) -> check_con_var v map
	
      (* check expressions *)
      | Expr (e) -> 
	 	checkexp map e
      (* check when we call functions? *)
      | Call (c, elist) ->

		if Hashtbl.mem g c 
		then 	(print_string ("calling opt: " ^ c ^" :");
			(let argtypes = Hashtbl.find g c
			in 
			if check_args map elist argtypes
			then print_endline(c ^" call passed with proper arguments")
			else 	(error.(0) <- true;
				print_endline (c ^ " call passed with incorrect arguments"))); 
				map)

		
		else
             		(error.(0) <- true; 
			print_endline ("ERROR: undefined opt: " ^ c);
               		map)
      (* if/while *)
      	| While (e, sl) ->
	  	(if not ((get_expr_type map e) = "int")
		then 	(error.(0) <- true;
			 print_endline ("While expression is not evaluating to an int"))
		else ();
		let _ = (List.fold_left checkstmt (checkexp map e) (sl)) in map)

	| If(e,sl1,sl2) ->
		(if not ((get_expr_type map e) = "int")
		 then 	(error.(0) <- true;
			print_endline ("If expression is not evaluating to an int"))
		 else print_string (""));
			(let _ = (List.fold_left  checkstmt   (checkexp map e) sl1) in
			 let _ = (List.fold_left  checkstmt   (checkexp map e) sl2) in
			 map) 
	| Crawl (cn , el, no ,ru)  ->
		if Hashtbl.mem crawlh cn
		then 
		let argtypes = Hashtbl.find crawlh cn
		in 
		if check_args map el argtypes  
		then 	if (check_node no map) && (Hashtbl.mem ruleh ru)
			then map 
			else (error.(0) <- true;
				print_endline("Wrong arguments passed to " ^cn^ " crawl in from-where clause"); 
				map)
		else  (error.(0) <- true;
			print_endline("Crawl " ^cn^ " called with improper arguments"); map) 
		else  (error.(0) <- true;
			print_endline("Crawl " ^cn^ " undefined"); 
			map)
	| CallRule -> 	
		if f.func_type = "crawl"
		then	 map
		else (print_endline(f.fname ^" is not a crawl.  Cannot use call"); map)
	| Print(el) -> 
		List.fold_left (fun m e-> let etyp = get_expr_type m e in
					match etyp with
					"edg" ->(error.(0) <- true;print_endline 
					("Edges cannot be printed"); m) 
					|"node" ->(error.(0) <- true;print_endline 
					("Nodes cannot be printed"); m)
					|"error" ->(error.(0) <- true;print_endline 
					("Expression could not be printed"); m)
					|_-> m
				)
				map
				el
	| SetRule(rl)->
		if f.func_type = "crawl"
		then	if Hashtbl.mem ruleh rl 
			then map
			else(error.(0) <- true;print_endline(rl ^" is not a declared rule"); map )
		else (error.(0) <- true;print_endline(f.fname ^" is not a crawl.  Cannot use SetRule");	
			map)	
	| RAdd(v)  ->	if check_node v map
			then map
			else (error.(0) <- true;print_endline("Adding variable not of type node"); map)
	| RAddFront(v) -> if check_node v map
			then map
			else (error.(0) <- true;print_endline("Adding variable not of type node"); map)
	| RAddBy(s,a,rp,i)-> map
	| RAddByFront(s,a,rp,i)-> map
	| EdgeCreation (v1, edg, v2) -> if check_node v1 map  && check_node v2 map
			then map
			else (error.(0) <- true;print_endline("Non nodes passed to variables"); 
			map)
	in        
	List.fold_left checkstmt formals_st f.body

let dump_table t = 
	print_endline "=================="; 
	print_endline "symbol table dump: "; 
   	ST.fold (fun k v l -> print_endline ("--> " ^ k ^ ": " ^ v)) t ()

let dump_tuple t = 
  	(
	print_endline ("---> " ^ (fst t) ^ ": " ^ (string_of_int (List.length (snd t))));
	List.map print_endline (snd t);
  	)

let dump_hash h =
	print_endline "=================="; 
	print_endline "global signature dump: "; 
	Hashtbl.iter (fun a b -> ( print_string (a ^ ": "); 
				List.fold_right 
					(fun c d -> print_string ((fst c) ^"" ^(snd c) ^ " ")) b (); 
				print_endline ""; ) )
	h;

	print_endline "=================="

let check_ast (p : program) = 
	match p with 
	(fdecllist) -> 
		let funcHash = Hashtbl.create 100 in 
		let crawlHash =Hashtbl.create 50 in
		let ruleHash = Hashtbl.create 50 in	
		(  List.fold_right 
			(fun a b -> assign_method a crawlHash ruleHash funcHash  ) 
			(fdecllist)
			() ;
		dump_hash funcHash;
	(
		if not (Hashtbl.mem funcHash "main")
		then  (error.(0) <- true; print_endline("No main function declared"))
		else (print_endline("Starting")) );
		List.fold_right (fun a b -> dump_table a) 
			(List.map 	(fun a -> make_table a funcHash crawlHash ruleHash) 
					(List.rev fdecllist)) 
			();
		if error.(0) 
		then print_endline "an error!" 
		else print_endline "no error!";
		error.(0)
	)




